home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qui.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  9.0 KB  |  329 lines
  1. ; /ports/emacs/GNU/el3.1 @(#)qui.el    1.3 12/20/90 
  2. ; /ports/home/sitaram/Gnu/qui_emacs @(#)qui.el    1.6 11/13/90 
  3. ;;;              QUI - GNU Emacs Interface
  4. ;;;              Support Functions
  5. ;;;
  6. ;;;          Consolidated by Sitaram Muralidhar
  7. ;;;
  8. ;;;             sitaram@quintus.com
  9. ;;;            Quintus Computer Systems, Inc.
  10. ;;;                 12 Nov 1990
  11. ;;;
  12. ;;;    This file defines functions that support the QUI - GNU Emacs
  13. ;;;                  interface.
  14.  
  15.  
  16. (defvar port 0 
  17.  "The port number emacs will connect to")
  18. (defvar hostname 0
  19.  "The hostname to connect to")
  20. (defvar qui-arg 0
  21.  "The command argument sent by QUI")
  22. (defvar *qui-packet-pending* nil
  23.   "Processing the same packet ? ")
  24. (defvar  *packet-length* 0
  25.   "Length of curent command")
  26. (defconst  space  " ")
  27.  
  28. ;;;
  29. ;;; Emacs -> Qui commands
  30. ;;;
  31. (defvar EMACSUP  "emacsup "
  32.   "Qui-Emacs interface startup message")
  33. (defvar EDFAILED "edfailed "
  34.   "Qui-Emacs edit failed message")
  35. (defvar FINDDEF  "finddef "
  36.   "Qui-Emacs find definition")
  37. (defvar LOADFILE "loadfile"
  38.   "Qui-Emacs load -compile file")
  39. (defvar LOADPRED "loadpred"
  40.   "Qui-Emacs load -compile predicate")
  41. (defvar LOADREGI "loadregi"
  42.   "Qui-Emacs load -compile region")
  43. (defvar NOMODULE "_NoModule_"
  44.   "Qui-Emacs no module flag")
  45. ;;;
  46. ;;;  Qui -> Emacs commands
  47. ;;;
  48. (defvar EDITFILE "editfile"
  49.   "Qui-Emacs edit file command")
  50. (defvar FOUNDDEF "founddef"
  51.   "Qui-Emacs found requested definition")
  52. (defvar ENDDEF   "enddef  "
  53.   "Qui-Emacs found all definitions")
  54. (defvar BLTINDEF "bltindef"
  55.   "Qui-Emacs is a builtin predicate")
  56. (defvar NONEDEF  "nonedef "
  57.   "Qui-Emacs is not defined")
  58. (defvar UNDEF    "undefdef"
  59.   "Qui-Emacs is an undefined predicate")
  60. (defvar CLEARDEF "cleardef"
  61.   "Qui-Emacs clear file defn buffer")
  62. (defvar CANTLOAD "cantload"
  63.   "Qui-Emacs cannot load into prolog now")
  64. (defvar CANTCCP  "cantccp "
  65.   "Qui-Emacs cannot call prolog now")
  66. (defvar QUIQUIT  "qui_quit"
  67.   "Qui-Emacs qui has quit")
  68. (defvar SYNSTART  "synstart"
  69.   "Qui-Emacs qui has quit")
  70. (defvar SYNEND    "synend  "
  71.   "Qui-Emacs qui has quit")
  72. ;;;
  73. ;;; standard command length (number of separate strings)
  74. ;;;
  75.  
  76. (defvar  EDIT_FILE_LENGTH 2
  77.   " Number of args in edit-file command")
  78. (defvar     FOUND_DEF_LENGTH 4
  79.   " Number of args in founddef command")
  80. (defvar     ENDDEF_LENGTH      0
  81.   " Number of args in enddef command")
  82. (defvar     BLTIN_DEF_LENGTH 3
  83.   " Number of args in bltindef command")
  84. (defvar     NONEDEF_LENGTH   3
  85.   " Number of args in nonedef command")
  86. (defvar     UNDEF_LENGTH     3
  87.   " Number of args in undefdef command")
  88. (defvar     CLEARDEF_LENGTH  0
  89.   " Number of args in cleardef command")
  90. (defvar     CANTLOAD_LENGTH  0
  91.   " Number of args in cantload command")
  92. (defvar     CANTCCP_LENGTH   0
  93.   " Number of args in cantccp command")
  94. (defvar     QUI_QUIT_LENGTH   0
  95.   " Number of args in qui_quit command")
  96. (defvar     SYN_START_LENGTH   0
  97.   " Number of args in synstart command")
  98. (defvar     SYN_END_LENGTH    0
  99.   " Number of args in synend command")
  100.  
  101. ;;;
  102. ;;; get-load-path
  103. ;;;
  104.  
  105. (defun get-load-path (command-args)
  106.   (cond ((null command-args)
  107.      nil)
  108.     ((string-equal (car command-args) "-l")
  109.      (nth 1 command-args))
  110.     (t (get-load-path (cdr command-args)))
  111.   )
  112. )
  113. ;;;
  114. ;;; set up load-path
  115. ;;;
  116. (setq load-path (cons (file-name-directory
  117.             (get-load-path command-line-args))
  118.               load-path))
  119. ;;
  120. ;; load in support files
  121. ;;
  122. (load "qpfindpred.el"    )              ; Contains find definition
  123.                     ; support fns
  124. (load "qptokens.el"      )              ; Prolog tokenising stuff
  125. (load "qprolog-mode.el"  )              ; prolog mode functions
  126. (load "qprolog-indent.el")              ; For indentation stuff
  127. (load "qpfile-compl.el"  )        ; file-completion within qui-buffer
  128. (load "qui_aux.el"       )        ; For auxiliary function defns
  129. (load "qui_cmds.el"      )
  130. (load "qui_filter.el"    )
  131.  
  132. (defvar qui-mode-map nil)
  133. (if qui-mode-map 
  134.     nil
  135.   (setq qui-mode-map (make-sparse-keymap))
  136.   (define-key qui-mode-map "\t"         'prolog-indent-line       )
  137.   (define-key qui-mode-map "\e\C-q"     'prolog-indent-clause     )
  138.   (define-key qui-mode-map "\e\C-a"     'beginning-of-clause      )
  139.   (define-key qui-mode-map "\eh"     'mark-clause              )
  140.   (define-key qui-mode-map "\ef"     'forward-prolog-word      )
  141.   (define-key qui-mode-map "\eb"     'backward-prolog-word     )
  142.   (define-key qui-mode-map "\e\C-f"     'forward-term             )
  143.   (define-key qui-mode-map "\e\C-b"     'backward-term            )
  144.   (define-key qui-mode-map "\ed"     'kill-prolog-word         )
  145.   (define-key qui-mode-map "\e\177"     'backward-kill-prolog-word)
  146.   (define-key qui-mode-map "\e\C-k"     'kill-clause              )
  147.   (define-key qui-mode-map "\e\C-e"     'end-of-clause            )
  148.   (define-key qui-mode-map "\e."     'find-qui-definition      )
  149.   (define-key qui-mode-map "\e,"     'find-more-qui-definition )
  150.   (define-key qui-mode-map "\ek"     'qui-compile              )
  151.   (define-key qui-mode-map "\ei"     'qui-compile          )
  152.   (define-key qui-mode-map "\e#"     'shell-filename-complete  )
  153. )
  154.  
  155. (fset 'qui-mode 'qui-mode) 
  156. ;;
  157. ;; set auto-mode-alist to switch to qui-mode if file is .pl
  158. ;;
  159. (setq auto-mode-alist 
  160.       (append
  161.     '(("\\.pl$" . qui-mode))
  162.     auto-mode-alist))
  163.  
  164. (defun qui-mode ()
  165.   "Major mode for editing files of prolog code from QUI
  166.  The following commands are available:
  167.  \\{qui-mode-map}."
  168.   (interactive)
  169.   (kill-all-local-variables)
  170.   (use-local-map qui-mode-map)
  171.   (setq mode-name "qui")
  172.   (setq major-mode 'qui)
  173.   (or (mark) (set-mark 0)))
  174.  
  175. (defun initialize ()
  176.   "Get the network TCP paramters and open a connection, send an
  177. initialization done message to QUI"
  178.   ( setq port (string-to-int (getenv "QUI_PORT") ))
  179.   ( setq hostname (getenv "QUI_HOST" ))
  180.   ( open-connection hostname port )
  181.   ( qui-init )
  182. )
  183.  
  184. (defun get-arg (arg cmd-line )
  185.   "Returns the next argument after the arg switch."
  186.   ( cond ((null cmd-line) nil)
  187.      ((cond ((string-equal (car cmd-line) arg)
  188.          (nth 1 cmd-line))
  189.         (t (get-arg arg (cdr cmd-line)))))))
  190.  
  191. (defun open-connection (hostname port)
  192.   "Open a connection to port port and host hostname and associate
  193. buffer *qui-emacs* with it."
  194.   (switch-to-buffer "*qui-emacs*")
  195.   (qui-mode)
  196.   (setq qui-process
  197.     (open-network-stream "qui" "*qui-emacs*"  hostname port))
  198.   (set-process-filter qui-process 'qui-process-filter)
  199. )
  200.  
  201. (defun qui-init ()
  202.   (send-qui EMACSUP)
  203. )
  204.  
  205. (defun qui-process-filter (process packet)
  206.   (if *qui-packet-pending*
  207.       (continue-reading packet)
  208.       (begin-reading packet)
  209.   )
  210.   (display-any-messages)
  211. )
  212.  
  213. ;;;
  214. ;;; reinit - initializes all variables to their zero state
  215. ;;;
  216. (defun reinit ()
  217.   (setq *current-size* -1)
  218.   (setq *partial-arg*  "")
  219.   (setq *partial-size* "")
  220.   (setq *partial-command* "")
  221.   (setq *current-arg* 100)
  222. )
  223.  
  224. ;;;
  225. ;;; process-qui-packets: by the time this function is called "packet"
  226. ;;; represents a valid (complete) interface list. The car of this list
  227. ;;; is a qui-command and the cdr is a list of sizes and arguments
  228. ;;;
  229.  
  230. (defun process-qui-packets ()
  231.   (reinit)
  232.   (cond ((string-equal *packet-command* "editfile")
  233.      (edit-file arg2 (string-to-int arg1)))
  234.     ((string-equal *packet-command* "founddef")
  235.      (fill-defns arg4 arg3 arg2 arg1 ))
  236.     ((string-equal *packet-command* "bltindef")
  237.      (builtin arg3 arg2 arg1 ))
  238.     ((string-equal *packet-command* "nonedef ")
  239.      (nondef arg3 arg2 arg1))
  240.     ((string-equal *packet-command* "undefdef")
  241.      (undef arg3 arg2 arg1))
  242.     ((string-equal *packet-command* "enddef  ")
  243.      (enddef))
  244.     ((string-equal *packet-command* "qui_quit")
  245.      (qui-quit))
  246.     ((string-equal *packet-command* "cleardef")
  247.      (@fd-clear))
  248.     ((string-equal *packet-command* "cantload")
  249.      (cantload))
  250.     ((string-equal *packet-command* "cantccp ")
  251.      (cantccp))
  252.     ; The two following commands, synstart, synend do nothing
  253.     ; currently.
  254.     ((string-equal *packet-command* "synstart")
  255.      t)
  256.     ((string-equal *packet-command* "synend  ")
  257.      t)
  258.     
  259.     (t (message "Unknown Packet")))
  260.   (setq *partial-packet* nil))
  261.  
  262. ;;
  263. ;; returns the command string - the first eight characters
  264. ;;
  265.  
  266. (defun command (packet)
  267.   (let ((i 1))
  268.     (while (not (string-equal 
  269.           (substring packet i (+ i 1))
  270.           " "))
  271.       (setq i (+ i 1)))
  272.     (setq qui-arg (substring packet (+ i 1)))
  273.     (substring packet 0 i))
  274. )
  275.  
  276. ;;;
  277. ;;; command-length
  278. ;;;
  279.  
  280. (defun command-length ( command )
  281.   (cond ((string-equal command EDITFILE)
  282.      EDIT_FILE_LENGTH)
  283.     ((string-equal command FOUNDDEF)
  284.      FOUND_DEF_LENGTH)
  285.     ((string-equal command ENDDEF)
  286.      ENDDEF_LENGTH)     
  287.     ((string-equal command BLTINDEF)
  288.      BLTIN_DEF_LENGTH)
  289.     ((string-equal command NONEDEF)
  290.      NONEDEF_LENGTH)
  291.     ((string-equal command UNDEF)
  292.      UNDEF_LENGTH)
  293.     ((string-equal command CLEARDEF)
  294.      CLEARDEF_LENGTH)
  295.     ((string-equal command CANTLOAD)
  296.      CANTLOAD_LENGTH)
  297.     ((string-equal command CANTCCP)
  298.      CANTCCP_LENGTH)
  299.     ((string-equal command QUIQUIT)
  300.      QUI_QUIT_LENGTH)
  301.     ((string-equal command SYNSTART)
  302.      SYN_START_LENGTH)
  303.     ((string-equal command SYNEND)
  304.      SYN_END_LENGTH)
  305.   )
  306. )
  307.  
  308. ;;; returns length of STRING padded to four bytes
  309. ;;; currently handles strings less than 9999 characters long
  310.  
  311. (defun padded-length ( string ) 
  312.   (let ((len (length string)))
  313.     (cond ((<= len 9)
  314.        (concat len "   "))
  315.       ((and (<= len 99)
  316.         (> len 9))
  317.        (concat len "  "))
  318.       ((and (<= len 999)
  319.            (> len 99))
  320.        (concat len " "))
  321.       (t len))))
  322.        
  323. ;;;
  324. ;;; Actual interface function to QUI
  325.  
  326. (defun send-qui ( string )
  327.   ( process-send-string qui-process string )
  328. )
  329.